home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Atari Compendium
/
The Atari Compendium (Toad Computers) (1994).iso
/
files
/
umich
/
tex
/
td187src.lzh
/
MTAPPL.I
< prev
next >
Wrap
Text File
|
1991-06-08
|
20KB
|
738 lines
(*##########################################################################
MagicAppl: Basisfunktionen einer Applikation
##########################################################################
V2.01 27.01.91 Jens Pirnay ARGV wird unterstützt
V2.00 17.10.90 Peter Hellinger Anpassung an neues MagicSys
Die Implementationen für Megamax und
TDI-Modula unterscheiden sich nur
noch durch Compilerswitches.
V1.03 18.08.90 Peter Hellinger
V1.02 14.08.90 Peter Hellinger
V1.01 16.07.90 Peter Hellinger
V1.00 14.05.90 Peter Hellinger Implementation TDI-Modula-2
##########################################################################*)
IMPLEMENTATION MODULE mtAppl;
(*------------------------------*)
(* COMPILERSWITCHES *)
(*------------------------------*)
(* TDI-Version: DEAKTIVIERT *)
(*------------------------------*)
(* V- Overflow-Checks *)
(* R- Range-Checks *)
(* S- Stack-Check *)
(* N- NIL-Checks *)
(* T- TDI-Compiler vor 3.01 *)
(* Q+ Branch statt Jumps *)
(* *)
(*------------------------------*)
(* MM2-Version: DEAKTIVIERT *)
(*------------------------------*)
(*$R- Range-Checks *)
(*$S- Stack-Check *)
(* *)
(*------------------------------*)
FROM SYSTEM IMPORT ADDRESS, ADR, LONGWORD, BYTE, TSIZE;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM MagicVDI IMPORT UnloadFonts, SetTextface, SetCharpoints,
InqFacename, SetTexteffect, InqTextextent, InqText;
FROM MagicSys IMPORT Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6, Bit7,
Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14, Bit15,
LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL, sBITSET,
lWORD, lINTEGER, lCARDINAL, lBITSET,
CastToChar, CastToByte, CastToByteset, CastToInt,
CastToCard, CastToBitset, CastToWord, CastToLInt,
CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
Terminate, Basepage;
FROM MagicStrings IMPORT Append, Assign, Length;
IMPORT MagicTypes, MagicAES, MagicVDI, MagicDOS, MagicBIOS, MagicSys;
(*--------------------------------------------------------------------------*)
CONST cFonts = 0;
cOpen = 1;
ABCGEM = 0210H;
TYPE WsPtr = POINTER TO WsInfo;
WsInfo = RECORD
handle: sINTEGER;
flags: sBITSET;
next: WsPtr;
END;
TYPE TermPtr = POINTER TO TermInfo;
TermInfo = RECORD
proc: PROC;
next: TermPtr;
END;
VAR WorkInArray: MagicVDI.tWorkIn;
WorkOutArray: MagicVDI.tWorkOut;
applpath: ARRAY [0..255] OF CHAR;
VAR WorkStation: WsPtr;
TermProc: TermPtr;
VAR pCount: sINTEGER;
ProgReturn: sINTEGER;
stack: ADDRESS;
BasePage: MagicBIOS.PtrPD;
Maus: BOOLEAN;
MausForm: sINTEGER;
Usermaus: ADDRESS;
GEMversion: sINTEGER;
gdos: BOOLEAN;
argv: BOOLEAN;
argpos: sINTEGER;
cmdline: ARRAY [0..127] OF CHAR;
PROCEDURE ApplInit;
VAR i: sINTEGER;
BEGIN
(* Applikation anmelden *)
ApplIdent:= MagicAES.ApplInit ();
IF ApplIdent < 0 THEN HALT; END;
(* Eine Workstation öffnen *)
VDIHandle:= OpenWorkstation();
(* Gesamtbreite und Höhe des Bildschirms *)
MaxWidth:= WorkOutArray[0] + 1;
MaxHeight:= WorkOutArray[1] + 1;
Bitplanes:= MagicAES.AESGlobal.apNplanes;
GEMversion:= MagicAES.AESGlobal.apVersion;
IF GEMversion # ABCGEM THEN gdos:= MagicSys.VqGdos();
ELSE gdos:= TRUE;
END;
Maus:= TRUE; MausForm:= MagicAES.ARROW; MouseOn;
END ApplInit;
PROCEDURE InstallTermproc (proc: PROC);
VAR p: TermPtr;
PROCEDURE new (): TermPtr;
VAR q: TermPtr;
BEGIN
NEW (q);
IF q = NIL THEN HALT; END;
q^.proc:= proc;
q^.next:= NIL;
RETURN q;
END new;
BEGIN
IF TermProc = NIL THEN
TermProc:= new ();
ELSE
p:= TermProc;
WHILE p^.next # NIL DO p:= p^.next; END;
p^.next:= new ();
END;
END InstallTermproc;
PROCEDURE ApplTerm (return: sINTEGER);
VAR p: TermPtr;
q: WsPtr;
i: sINTEGER;
BEGIN
(* Installierte TermProcedures abarbeiten *)
p:= TermProc;
WHILE (p # NIL) DO p^.proc; p:= p^.next; END;
(* Cursor wieder sichtbar machen *)
MagicVDI.ShowCursor (VDIHandle, TRUE);
q:= WorkStation;
WHILE (q # NIL) DO
IF cFonts IN q^.flags THEN MagicVDI.UnloadFonts (q^.handle, 0); END;
MagicVDI.CloseVirtual (q^.handle);
q:= q^.next;
END; (* WHILE *)
MagicAES.ApplExit;
Terminate (return);
END ApplTerm;
PROCEDURE ApplPath (VAR pfad: ARRAY OF CHAR);
BEGIN
Assign (applpath, pfad);
END ApplPath;
PROCEDURE OpenWorkstation (): sINTEGER;
VAR h, i: sINTEGER;
p: WsPtr;
PROCEDURE new (handle: sINTEGER; flags: BITSET): WsPtr;
VAR q: WsPtr;
BEGIN
NEW (q);
IF q = NIL THEN HALT; END;
q^.handle:= handle;
q^.flags:= flags;
q^.next:= NIL;
RETURN q;
END new;
BEGIN
(* Handle der physikalischen Workstation ermitteln *)
MagicAES.GrafHandle (h, i, i, i, i);
IF h < 0 THEN HALT; END;
WorkInArray[ 0]:= 1; (* Aktuelle Auflösung *)
WorkInArray[ 1]:= 1; (* Linientyp, durchgehender Strich *)
WorkInArray[ 2]:= 1; (* Liniefarbe, schwarz *)
WorkInArray[ 3]:= 1; (* Markertyp, Punkt *)
WorkInArray[ 4]:= 1; (* Markerfarbe, schwarz *)
WorkInArray[ 5]:= 1; (* Textfont, Systemzeichensatz *)
WorkInArray[ 6]:= 1; (* Textfarbe, schwarz *)
WorkInArray[ 7]:= 1; (* Fülltyp, voll *)
WorkInArray[ 8]:= 1; (* Musterindex, *)
WorkInArray[ 9]:= 1; (* Musterfarbe, schwarz *)
WorkInArray[10]:= 2; (* RC-Koordinatensystem *)
(* Virtuelle Workstation öffnen *)
MagicVDI.OpenVirtual (WorkInArray, h, WorkOutArray);
IF h < 0 THEN HALT; END;
IF WorkStation = NIL THEN
WorkStation:= new (h, {cOpen});
ELSE
p:= WorkStation;
WHILE p^.next # NIL DO p:= p^.next; END;
p^.next:= new (h, {cOpen});
END;
RETURN h;
END OpenWorkstation;
PROCEDURE GetWS (handle: sINTEGER): WsPtr;
VAR p: WsPtr;
BEGIN
p:= WorkStation;
WHILE p # NIL DO
IF p^.handle = handle THEN RETURN p; END;
p:= p^.next;
END;
RETURN NIL;
END GetWS;
PROCEDURE CloseWorkstation (handle: sINTEGER);
VAR p, q: WsPtr;
BEGIN
p:= GetWS (handle);
IF p # NIL THEN
IF cOpen IN p^.flags THEN
IF cFonts IN p^.flags THEN UnloadFonts (p^.handle, 0); END;
MagicVDI.CloseVirtual (p^.handle);
EXCL (p^.flags, cOpen);
END;
END; (* IF *)
END CloseWorkstation;
(*----------------------------------------------------------------------*
* Mäusetreiberei *
*----------------------------------------------------------------------*)
PROCEDURE MouseOn;
BEGIN
IF NOT Maus THEN
Maus:= TRUE;
MagicVDI.ShowCursor (VDIHandle, FALSE);
END;
IF MausForm = MagicAES.USERDEF THEN
MagicAES.GrafMouse (MausForm, Usermaus);
ELSE
MagicAES.GrafMouse (MausForm, Nil);
END;
END MouseOn;
PROCEDURE MouseArrow;
BEGIN
MausForm:= MagicAES.ARROW; MouseOn;
END MouseArrow;
PROCEDURE MouseCursor;
BEGIN
MausForm:= MagicAES.TEXTCRSR; MouseOn;
END MouseCursor;
PROCEDURE MouseBusy;
BEGIN
MausForm:= MagicAES.BUSYBEE; MouseOn;
END MouseBusy;
PROCEDURE